home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibcalc.arc / SETGUYS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-08  |  2KB  |  79 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                      SetBase --- Set default base                        *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE SetBase( b: basety );
  6.  
  7. BEGIN  (* SetBase *)
  8.  
  9.    CheckEol;
  10.  
  11.    base := b;
  12.  
  13. END    (* SetBase *);
  14.  
  15. (*--------------------------------------------------------------------------*)
  16. (*                     SetAngle --- Set units for trig functions            *)
  17. (*--------------------------------------------------------------------------*)
  18.  
  19. PROCEDURE SetAngle( a: anglety );
  20.  
  21. BEGIN  (* SetAngle *)
  22.  
  23.    CheckEol;
  24.    angle := a;
  25.  
  26. END    (* SetAngle *);
  27.  
  28. (*--------------------------------------------------------------------------*)
  29. (*        SetFrac --- Set no. of digits to display after dec. pt.           *)
  30. (*--------------------------------------------------------------------------*)
  31.  
  32. PROCEDURE SetFrac;
  33.  
  34. LABEL
  35.    99  (* ERROR EXIT *);
  36.  
  37. BEGIN  (* SetFrac *)
  38.  
  39.    NextTok;
  40.                                    (* Look for equal sign *)
  41.    IF Token <> equalssy THEN
  42.       BEGIN
  43.          SynErr;
  44.          GOTO 99;
  45.       END;
  46.  
  47.    NextTok;
  48.                                    (* Look for constant *)
  49.    IF Token <> constsy THEN
  50.       BEGIN
  51.          SynErr;
  52.          GOTO 99;
  53.       END;
  54.                                    (* Check for garbage after constant *)
  55.    CheckEol;
  56.    IF ErrorFlag THEN GOTO 99;
  57.                                    (* Must have integer constant *)
  58.    WITH constval DO
  59.    BEGIN
  60.  
  61.       IF typ <> INT THEN
  62.          BEGIN
  63.             SynErr;
  64.             GOTO 99;
  65.          END;
  66.                                    (* Must have <= 15 decimal places *)
  67.       IF i > 15 THEN
  68.          BEGIN
  69.             Error('FRAC must be <= 15');
  70.             GOTO 99;
  71.          END;
  72.  
  73.       FRAC := i;
  74.  
  75.    END;
  76.  
  77. 99:
  78. END  (* SetFrac *);
  79.